unit uToneGenerator;
(* NOTE:  This IS the tone generator in the Tone Generator...
  Removed the save attempt and killed the menu 2005-02-26
  V2.2.2  1997 Oct 06  Version for Delphi 3.01
  Don't progress programmed mode
  Add Pink noise mode
  Added very low level output when left slider is OFF 2007-02-24
*)

interface

{$A-}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  MMSystem, mmErrMsg, ComCtrls, Menus, AxCtrls, OleCtrls, DbOleCtl,
  _GClass, AbGradient, AbNumEdit;

const
  sample_rate = 44100; // i.e. best CD quality
  // note: 10ms -> exactly 441 samples
  sine_table_samples = 1 shl 15; // number of samples in sine table
  max_buffer_samples = 57330; // size of output buffer for 1.3 seconds
  // four times this in bytes
  pink_noise_filename = 'pink.wav';

type
  audio_sample = -32767 .. 32767; // for 16-bit audio

type
  PSineTable = ^TSineTable; // sine value store
  TSineTable = array [0 .. sine_table_samples - 1] of audio_sample;

  PMonoBuffer = ^TMonoBuffer; // pink noise buffer type
  TMonoBuffer = array [0 .. max_buffer_samples - 1] of audio_sample; // 1-channel

  PBuffer = ^TBuffer; // output buffer type
  TBuffer = array [0 .. 2 * max_buffer_samples - 1] of audio_sample; // 2-channels

  ranges = (lf, mf, hf, wide); // sweep ranges
  modes = (logarithmic, linear); // sweep modes
  speeds = (fast_stepped, fast_smooth, white, pink, slow, programmed, manual, no_sweep);
  // sweep speeds
  out_levels = (phase_normal, phase_reverse, independent); // output modes

  out_freqs = array [0 .. 0] of extended;

type
  TfToneGenerator = class(TForm)
    pnlMain: TPanel;
    gbFrequencyRange: TRadioGroup;
    grpSweepMode: TRadioGroup;
    grpSweepSpeed: TRadioGroup;
    edtF1: TEdit;
    Label1: TLabel;
    edtF2: TEdit;
    Label2: TLabel;
    lblFnow: TLabel;
    grpOctaveMarkers: TGroupBox;
    chkOctaveMarker: TCheckBox;
    lblLastMarker: TLabel;
    GroupBox1: TGroupBox;
    tkbLeftLevel: TTrackBar;
    tkbRightLevel: TTrackBar;
    lblLeftLevel: TLabel;
    lblRightLevel: TLabel;
    Label3: TLabel;
    grpChannels: TRadioGroup;
    chkLeft: TCheckBox;
    chkRight: TCheckBox;
    grpSetFrequency: TGroupBox;
    tkbLeftFrequency: TTrackBar;
    tkbRightFrequency: TTrackBar;
    cbLockFreq: TCheckBox;
    lblFMaxR: TLabel;
    lblFMinR: TLabel;
    lblFMaxL: TLabel;
    lblFMinL: TLabel;
    lblFLeft: TLabel;
    lblFRight: TLabel;
    Timer: TTimer;
    SaveDialog1: TSaveDialog;
    gradient: TAbGradient;
    btnStart: TButton;
    btnExit: TButton;
    tbLowPower: TTrackBar;
    lblLeftAttn: TLabel;
    gbChirpControl: TGroupBox;
    nsChirp: TAbNumSpin;
    cbChirp: TCheckBox;
    lblHzPerSec: TLabel;
    lblChirpCum: TLabel;
    timerChirp: TTimer;
    btnAddWhiteNoise: TButton;
    procedure btnExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure grpSweepModeClick(Sender: TObject);
    procedure grpSweepSpeedClick(Sender: TObject);
    procedure gbFrequencyRangeClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnStartKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure tkbLeftLevelChange(Sender: TObject);
    procedure tkbRightLevelChange(Sender: TObject);
    procedure grpChannelsClick(Sender: TObject);
    procedure chkLeftClick(Sender: TObject);
    procedure tkbLeftFrequencyChange(Sender: TObject);
    procedure tkbRightFrequencyChange(Sender: TObject);
    procedure cbLockFreqClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure edtF1Change(Sender: TObject);
    procedure edtF2Change(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure cbChirpClick(Sender: TObject);
    procedure timerChirpTimer(Sender: TObject);
    procedure btnAddWhiteNoiseClick(Sender: TObject);
  private
    { Private declarations }
    WhiteRunning: Boolean;
    FChirpCum: real;
    left_angle, right_angle: integer; // current sine wave angles
    left_sine_table, right_sine_table: PSineTable; // pre-stored sine-wave values
    left_sine_table_valid, right_sine_table_valid: Boolean; // table-valid flags
    pink_noise_buffer: PMonoBuffer; // pre-stored pink noise
    hWave_hdr1: HGlobal; // wave header handles
    hWave_hdr2: HGlobal;
    p_wave_hdr1: PWaveHdr; // wave header pointers
    p_wave_hdr2: PWaveHdr;
    hBuffer1: HGlobal; // output buffer handles
    hBuffer2: HGlobal;
    p_buffer1: PBuffer; // output buffer pointers
    p_buffer2: PBuffer;
    buffer_bytes: integer; // max number of bytes in each output buffer
    f_min, f_max: integer; // limits of sweep range
    buffers_written, buffers_played: integer; // for tracking the slow sweep
    all_written: Boolean; // so we know when to stop the sweep
    fl, fr: extended; // current left and right frequencies
    f_ratio, f_step: extended;
    last_f: extended;
    f_inv_ratio: extended;
    direction: (up, down, holding); // for manual sweep mode
    current_octave: integer; // to know whether to add a marker
    next_octave: integer;
    do_markers: Boolean; // true if makers (balnks) are required
    hWave_out: HWaveOut; // handle to wave out device
    pcm: TWaveFormatEx; // wave format descriptor
    sweep_running: Boolean;
    shutoff: Boolean;
    closing: Boolean;
    closed: Boolean;
    log_lin: modes;
    speed: speeds;
    range: ranges;
    out_level: out_levels; // in-phase, out-of-phase or independent
    locked_frequencies: Boolean; // true for same freq in left and right
    chunk_freq: ^out_freqs;
    slow_sweep_time: integer; // duration of slow sweep (milliseconds)
    slow_sweep_chunks: integer; // the number of chunks in the buffer
    chunk_ms: integer; // duration of each chunk in milliseconds
    left_amplitude: extended; // 1.0 is 0dB, 0.5 is -6dB etc
    right_amplitude: extended;
    present_left_amplitude: extended; // to tell if the amplitude has changed
    present_right_amplitude: extended;
    procedure restart_sweep;
    procedure stop_sweep;
    procedure start_sweep;
    procedure level_changed;

    // call-backs from waveform out functions
    procedure mm_wom_Open(var Msg: TMessage); message mm_wom_Open;
    procedure mm_wom_Done(var Msg: TMessage); message mm_wom_Done;
    procedure mm_wom_Close(var Msg: TMessage); message mm_wom_Close;

    // procedure just to fill a buffer - independent of mode
    function fill_buffer(h: HMMIO): integer;
    function fill_single_sweep_bfr(bfr: PBuffer; num_freqs: integer): integer;
    function fill_white_noise_bfr(bfr: PBuffer): integer;
    function fill_pink_noise_bfr(bfr: PBuffer): integer;

    // copies from sine table into buffer, offset if right channel sine table
    procedure fill_buffer_with_sinewave(sine_table: PSineTable; bfr: PBuffer; f: extended; var angle: integer;
      index, samples: integer);

    procedure write_next_buffer(header: PWaveHdr);

    // populate a sine table for the present amplitude
    procedure build_sine_table(magnitude: extended; table: PSineTable);
    procedure build_left_sine_table; // fill left channel sine table
    procedure build_right_sine_table; // fill right channel sine table

    function get_octave(f: extended): integer;
    function read_pink_noise_file(const filename: string): Boolean;
    procedure PlayResourceWAV(SoundResourceID: String; SyncOrAsync: integer);
  public
    { Public declarations }
    function ShutDown: Boolean;
  end;

var
  fToneGenerator: TfToneGenerator;
  h: HMMIO;

implementation

uses
  Math, ProgramForm;

{$R *.DFM}
// {$R LED.DCR}

procedure TfToneGenerator.FormCreate(Sender: TObject);
var
  dB: integer;
begin
  // set the initial amplitude slider positions for -12dB
  tkbLeftLevel.Position := 12;
  tkbRightLevel.Position := 12;

  // generate the labels for the dB markings on the amplitude sliders
  for dB := 0 to 25 do
    if (dB mod 5) = 0 then // add labels every 5 dB
      with TLabel.Create(GroupBox1) do
      begin
        Parent := GroupBox1;
        Caption := IntToStr(-dB);
        Left := 0;
        Top := tkbLeftLevel.Top + 8 + (dB * (tkbLeftLevel.Height - 27)) div 26;
        Width := GroupBox1.Width; // span the whole box transparently
        Alignment := taCenter; // then centre the text in the box
        AutoSize := False; // keeping the size intact
        Transparent := True;
        if dB < 6 { // set colour according to level } then
          Font.Color := clRed
        else
          if dB < 11 then
            Font.Color := clYellow
          else
            Font.Color := clGreen;
      end;

  // set the default positions for the RadioGroup boxes, this forces the
  // dependant variables and the label captions to be set
  grpSweepMode.ItemIndex := 1;
  gbFrequencyRange.ItemIndex := 0;
  grpSweepSpeed.ItemIndex := 0;
  grpChannels.ItemIndex := 0;

  // get the memory required for wave headers
  // this code is probably irrelevant in the Win32 environment
  hWave_hdr1 := GlobalAlloc(gHnd or gMem_Share, SizeOf(TWaveHdr));
  p_wave_hdr1 := PWaveHdr(GlobalLock(hWave_hdr1));
  hWave_hdr2 := GlobalAlloc(gHnd or gMem_Share, SizeOf(TWaveHdr));
  p_wave_hdr2 := PWaveHdr(GlobalLock(hWave_hdr2));

  // define nominal values for sweep - may be overwritten in programmed mode
  chunk_ms := 250; // 250ms for four freq's per second
  slow_sweep_time := 45000; // and 45 seconds for the sweep
  slow_sweep_chunks := slow_sweep_time div chunk_ms;

  // estimate of reasonable output buffer size for 1.3 seconds of audio
  // this should make the active portion of the fast sweep just 50ms per chunk
  // double the number of bytes to get samples per channel
  buffer_bytes := 2 * (13 * sample_rate) div 10;
  if buffer_bytes > 2 * max_buffer_samples then
    buffer_bytes := 2 * max_buffer_samples;

  // get the memory required for output buffers
  // the final * 2 is for 2 channels
  hBuffer1 := GlobalAlloc(gHnd or gMem_Share, buffer_bytes * 2);
  p_buffer1 := PBuffer(GlobalLock(hBuffer1));
  hBuffer2 := GlobalAlloc(gHnd or gMem_Share, buffer_bytes * 2);
  p_buffer2 := PBuffer(GlobalLock(hBuffer2));
  if (hBuffer1 = 0) or (hBuffer2 = 0) then
    ShowMessage('Failed to get memory for output buffers');

  hWave_out := 0;

  // get memory for the sine-wave tables and note they haven't yet been built
  GetMem(left_sine_table, SizeOf(TSineTable));
  GetMem(right_sine_table, SizeOf(TSineTable));
  if (left_sine_table = nil) or (right_sine_table = nil) then
    ShowMessage('Failed to get memory for sine-wave tables');
  left_sine_table_valid := False;
  right_sine_table_valid := False;

  pink_noise_buffer := nil;

  locked_frequencies := True; // assume we're working normally

  // set present amplitude to an invalid value
  present_left_amplitude := -1.0;
  present_right_amplitude := -1.0;
  out_level := phase_normal;

  // fill in the standard header
  with pcm do
  begin
    wFormatTag := wave_Format_PCM; // it's PCM data
    nChannels := 2; // 2 channels
    nSamplesPerSec := sample_rate; // set the 44.1KHz rate
    nAvgBytesPerSec := 4 * sample_rate; // two bytes per sample
    nBlockAlign := 4; // for 2-channel 16-bit audio
    wBitsPerSample := 16; // 16-bit audio
    cbSize := 0;
  end;

  // set other state variables
  shutoff := False;
  closing := False;
  sweep_running := False;
  level_changed; // get a valid value for the amplitudes
end;

function TfToneGenerator.ShutDown: Boolean;

begin
  FormDestroy(Self);

end;

procedure TfToneGenerator.FormDestroy(Sender: TObject);
begin

  stop_sweep;
  shutoff := True;
  // return allocated memory
  GlobalUnlock(hWave_hdr1);
  GlobalFree(hWave_hdr1);
  GlobalUnlock(hBuffer1);
  GlobalFree(hBuffer1);
  GlobalUnlock(hWave_hdr2);
  GlobalFree(hWave_hdr2);
  GlobalUnlock(hBuffer2);
  GlobalFree(hBuffer2);
  // (*
  FreeMem(left_sine_table, SizeOf(TSineTable));
  FreeMem(right_sine_table, SizeOf(TSineTable));
  if pink_noise_buffer <> nil then
    FreeMem(pink_noise_buffer);
  // *)
end;

procedure TfToneGenerator.btnAddWhiteNoiseClick(Sender: TObject);
begin

    if not WhiteRunning then
    begin
      PlayResourceWAV('WhiteNoise', SND_ASYNC);
      btnAddWhiteNoise.Caption := 'White Noise ON';
      WhiteRunning := True;
    end
    else
    begin
      PlaySound(nil, 0, 0);
         btnAddWhiteNoise.Caption := 'White Noise OFF';
      WhiteRunning := False;
    end;

end;

procedure TfToneGenerator.btnExitClick(Sender: TObject);
begin
  stop_sweep;
  Close;
end;

procedure TfToneGenerator.level_changed;
// Called whenever the sine tables may need to be re-done,
// such as when the output level has changed in some way.

  function dB_to_amplitude(dB: integer): extended;
  begin
    Result := 1.0;
    if dB <> 0 then
      // Result := power(10.0, -dB / 20.0);
      Result := power(10.0, -dB / tbLowPower.Position);
  end;

begin
  left_amplitude := 0.0;
  right_amplitude := 0.0;

  if chkLeft.Checked { // left channel open? } then
  begin // convert dB to amplitude value
    left_amplitude := dB_to_amplitude(tkbLeftLevel.Position);
    lblLeftAttn.Caption := 'Left Attn: ' + IntToStr(tbLowPower.Position - 20) + ' dB';
    lblLeftLevel.Caption := '-' + IntToStr(tkbLeftLevel.Position);
  end
  else
  begin
    lblLeftLevel.Caption := 'Off';
    // left_amplitude := (1 div tbLowPower.Position )   ;
  end;
  if chkRight.Checked { // right channel open? } then
  begin
    right_amplitude := dB_to_amplitude(tkbRightLevel.Position);
    lblRightLevel.Caption := '-' + IntToStr(tkbRightLevel.Position);
  end
  else
    lblRightLevel.Caption := 'Off';

  // If the level may have changed, queue up a possible restart of the sweep.
  // This allows for several small changes to be made without the continual
  // interruption of the sweep re-starting.  It also seems that unless there
  // is _some_ delay, my code can't handle repeated sweep restarts, probably
  // due to messages becoming lost.....
  Timer.Enabled := True; // 1 second delay
end;

procedure TfToneGenerator.TimerTimer(Sender: TObject);
begin
  Timer.Enabled := False; // this is a single-shot timer
  lblFnow.Caption := '';
  // see if level is different - if so, we need to regenerate the sine table
  if present_left_amplitude <> left_amplitude then
    left_sine_table_valid := False;
  if present_right_amplitude <> right_amplitude { // and for the right channel } then
    right_sine_table_valid := False;
  if (present_left_amplitude <> left_amplitude) or (present_right_amplitude <> right_amplitude) then
    restart_sweep;
end;

procedure TfToneGenerator.grpSweepModeClick(Sender: TObject);
// This is typical of the code for all the RadioGroups.  Find
// the current string and decode it.  Set a label caption equal
// to the decoded value, often just the current string
var
  current: string;
begin
  current := grpSweepMode.Items.Strings[grpSweepMode.ItemIndex];
  if current = 'Linear' then
    log_lin := linear;
  if current = 'Log' then
    log_lin := logarithmic;
  lblFnow.Caption := LowerCase(current);
  // The sweep parameters have changed, so restart any sweep in progress
  restart_sweep;
end;

(* P L A Y   R E S O U R C E   W A V *)
procedure TfToneGenerator.PlayResourceWAV(SoundResourceID: String; SyncOrAsync: integer);
var
  hFind, hRes: THandle;
  Song: pChar;
begin
  hFind := FindResource(HInstance, PWideChar(SoundResourceID), 'WAVE');
  // Play the White file

  if hFind <> 0 then
  begin
    hRes := LoadResource(HInstance, hFind);
    if hRes <> 0 then
    begin
      Song := LockResource(hRes);
      if Assigned(Song) then
      begin
        if (SyncOrAsync = SND_ASYNC) then
          SndPlaySound(Song, SND_ASYNC OR snd_Memory OR SND_LOOP) // Start play and go on
        else
          SndPlaySound(Song, SND_SYNC or snd_Memory OR SND_LOOP);
        // Start play and wait for finish
      end;
      UnlockResource(hRes);
    end;
    FreeResource(hFind);
  end { of song };
end;

procedure TfToneGenerator.grpSweepSpeedClick(Sender: TObject);
var
  current: string;
  chunk_duration: integer;
  chunk_samples: integer;
begin
  // set "speed" according to the decoded string value
  current := grpSweepSpeed.Items.Strings[grpSweepSpeed.ItemIndex];
  if current = 'Slow' then
    speed := slow;
  if current = 'Programmed' then
    speed := programmed;
  if current = 'Manual' then
    speed := manual;
  if current = 'Fast (stepped)' then
    speed := fast_stepped;
  if current = 'Fast (smooth)' then
    speed := fast_smooth;
  if current = 'No sweep' then
    speed := no_sweep;
  if current = 'White noise' then
    speed := white;
  if current = 'White File' then
  begin
    if sweep_running then
      PlayResourceWAV('WhiteNoise', SND_ASYNC);

  end;

  // show the lower frequency edit box if appropriate
  case speed of
    slow, programmed, manual, fast_stepped, fast_smooth, no_sweep:
      edtF1.Visible := True;
    white, pink:
      edtF1.Visible := False;
  end;

  if speed = programmed then
  begin
    with frmProgram do
    begin
      TotalDuration := slow_sweep_time;
      FrequencySteps := slow_sweep_chunks;
      StartFrequency := f_min;
      EndFrequency := f_max;
      LevelList := lblLeftLevel.Caption;
      if ShowModal = mrOK then
      begin
        chunk_duration := TotalDuration div FrequencySteps; // in milliseconds
        if chunk_duration < 100 then
          Application.MessageBox('Using your requested values results in steps that last less ' +
            'than 100ms.'#13'This may cause gaps in the audible output', 'Sweep too short or too many steps',
            MB_ICONWARNING);
        chunk_samples := chunk_duration * sample_rate div 1000;
        if chunk_samples > max_buffer_samples then
        begin
          chunk_samples := max_buffer_samples;
          chunk_duration := (chunk_samples * 1000) div sample_rate;
          FrequencySteps := TotalDuration div chunk_duration;
          Application.MessageBox(pChar('Using you requested values results in ' +
            'steps that exceed 1.3 seconds - outside the program''s range.'#13 +
            'Number of steps will be increased to ' + IntToStr(FrequencySteps)),
            'Sweep too long or too few steps', MB_ICONWARNING);
        end;
        edtF1.Text := IntToStr(StartFrequency);
        edtF2.Text := IntToStr(EndFrequency);
        slow_sweep_time := TotalDuration;
        slow_sweep_chunks := FrequencySteps;
        chunk_ms := chunk_duration;
      end;
    end;
  end;

  // show the second frequency edit box if appropriate
  case speed of
    slow, programmed, manual, fast_stepped, fast_smooth:
      edtF2.Visible := True;
    white, pink, no_sweep:
      edtF2.Visible := False;
  end;

  if speed = slow then
  begin
    chkOctaveMarker.Enabled := True;
    lblLastMarker.Enabled := True;
  end
  else
  begin
    lblLastMarker.Enabled := False;
    chkOctaveMarker.Enabled := False;
  end;

  lblFLeft.Caption := edtF1.Text;
  lblFRight.Caption := edtF1.Text;

  if speed = manual then
  begin // set the paramters for the freq trackbar
    with tkbLeftFrequency do
    begin
      Max := slow_sweep_chunks;
      Min := 1;
      LineSize := 1;
      PageSize := LineSize * 10;
      Enabled := True;
    end;
    with tkbRightFrequency do
    begin
      Max := tkbLeftFrequency.Max; // same as the left trackbar
      Min := 1;
      LineSize := 1;
      PageSize := LineSize * 10;
      Enabled := True;
    end;
    cbLockFreq.Enabled := True;
    lblFMinL.Enabled := True;
    lblFMinR.Enabled := True;
    lblFMaxL.Enabled := True;
    lblFMaxR.Enabled := True;
    lblFLeft.Enabled := True;
    lblFRight.Enabled := True;
  end
  else
  begin
    tkbLeftFrequency.Enabled := False;
    tkbRightFrequency.Enabled := False;
    cbLockFreq.Enabled := False;
    lblFMinL.Enabled := False;
    lblFMinR.Enabled := False;
    lblFMaxL.Enabled := False;
    lblFMaxR.Enabled := False;
    lblFLeft.Enabled := False;
    lblFRight.Enabled := False;
  end;

  with tkbLeftFrequency do
    Position := Max;
  with tkbRightFrequency do
    Position := Max;

  lblFnow.Caption := LowerCase(current);
  direction := holding;
  restart_sweep;
end;

procedure TfToneGenerator.gbFrequencyRangeClick(Sender: TObject);
var
  f1, f2: integer;
  current: string;
begin
  // decode the settings into "range" and hence a pair of frequencies
  current := gbFrequencyRange.Items.Strings[gbFrequencyRange.ItemIndex];
  if current = 'Wide  (20Hz .. 20KHz)' then
    range := wide;
  if current = 'HF  (1KHz .. 15KHz)' then
    range := hf;
  if current = 'Speech  (300Hz .. 3KHz)' then
    range := mf;
  if current = 'LF  (50Hz .. 1KHz)' then
    range := lf;
  case range of
    lf:
      begin
        f1 := 50;
        f2 := 1000;
      end;
    mf:
      begin
        f1 := 300;
        f2 := 3000;
      end;
    hf:
      begin
        f1 := 1000;
        f2 := 15000;
      end;
    wide:
      begin
        f1 := 20;
        f2 := 20000;
      end;
  else
    begin
      f1 := 300;
      f2 := 3000;
    end;
  end;

  // set f_min and f_max so that frequency slide labels display correctly
  f_min := f1;
  f_max := f2;

  // record the new frequency range in the Edit boxes and trackbar labels
  edtF1.Text := IntToStr(f1);
  edtF2.Text := IntToStr(f2);

  case range of
    lf:
      lblFnow.Caption := 'lf';
    mf:
      lblFnow.Caption := 'mf';
    hf:
      lblFnow.Caption := 'hf';
    wide:
      lblFnow.Caption := 'wide';
  end;

  restart_sweep;
end;

procedure TfToneGenerator.restart_sweep;
begin
  if sweep_running then
    start_sweep;
end;

procedure TfToneGenerator.stop_sweep;
begin
  // Is a sweep running?  If so, stop it
  if sweep_running then
  begin
    shutoff := True;
    waveOutReset(hWave_out);
    sweep_running := False;

    closed := False;
    repeat
      Application.ProcessMessages;
    until closed;
  end
end;

procedure TfToneGenerator.start_sweep;
var
  open_status: MMRESULT;
  code: integer;
begin
  if sweep_running then
    stop_sweep;

  // try to convert the text in the edit boxes to numbers
  Val(edtF1.Text, f_min, code);
  if code <> 0 then
    f_min := 150;
  Val(edtF2.Text, f_max, code);
  if code <> 0 then
    f_max := 300;

  // just for the slow sweep, see if the octave marker gaps are required
  do_markers := chkOctaveMarker.State = cbChecked;
  lblLastMarker.Caption := 'Last at:';

  left_angle := 0;
  right_angle := 0;

  shutoff := False;
  // try and open the wave device for our format of wave data
  // will result in a mm_wave_open message
  open_status := waveOutOpen(@hWave_out, 0, @pcm, Handle, 0, callback_window);

  if open_status = 0 then
  begin
    // prepare to receive the WaveOutOpen message to actually start sending data
    sweep_running := True;
    grpChannels.Enabled := False; // we don't change this while running
    grpOctaveMarkers.Enabled := False;
    chkOctaveMarker.Enabled := False;
    edtF1.Enabled := False;
    edtF2.Enabled := False;
    closed := False;
    case speed of
      slow, programmed, no_sweep, manual:
        begin
          lblFnow.Caption := IntToStr(f_min) + ' Hz';
          lblFnow.Visible := True;
        end;
    end;
    if speed = programmed then
    begin
      tkbLeftLevel.Enabled := False;
      tkbRightLevel.Enabled := False;
      lblLeftLevel.Enabled := False;
      lblRightLevel.Enabled := False;
      chkLeft.Enabled := False;
      chkRight.Enabled := False;
      gbFrequencyRange.Enabled := False;
      grpSweepMode.Enabled := False;
      grpSweepSpeed.Enabled := False;
    end;
  end
  else
  begin
    sweep_running := False;
    hWave_out := 0;
    // inform user of failure
    // translate the most common error into English!
    if open_status = waverr_BadFormat then
      MessageDlg('Sorry, your sound card does not support' + #13#10 + 'stereo, 16-bit, ' +
        FloatToStr(sample_rate / 1000) + 'KHz audio', mtWarning, [mbOK], 0)
    else
      MessageDlg('Error opening waveform audio.' + #13 + translate_mm_error(open_status), mtWarning,
        [mbOK], 0);
  end;
end;

procedure TfToneGenerator.btnStartClick(Sender: TObject);
begin
  { is a sweep running?  if so, stop it }
  if sweep_running then
     stop_sweep
    else
    start_sweep;
end;

function TfToneGenerator.fill_buffer(h: HMMIO): integer;
var
  samples: integer;
  chunks: integer;
  buffer_fill: integer;
  chunk: integer; // loop over chunks for slow speed
  f: extended; // and the variable used to compute the freqs
begin
  // assume we fail to produce any results
  Result := 0;

  // build sine-wave tables if required
  if not left_sine_table_valid then
    build_left_sine_table;
  if not right_sine_table_valid then
    build_right_sine_table;
  chunk_freq := nil;

  case speed of
    fast_smooth, fast_stepped, white, pink:
      begin
        // fill in a single buffer that is repeated, fast sweep or white noise
        if speed = white then
          samples := fill_white_noise_bfr(p_buffer1) // white noise
        else
          if speed = pink then
            samples := fill_pink_noise_bfr(p_buffer1) // pink noise
          else
            if speed = fast_smooth then
              samples := fill_single_sweep_bfr(p_buffer1, 1000) // many frequencies
            else
              samples := fill_single_sweep_bfr(p_buffer1, 20); // just 20 frequencies
        if h <> 0 then
          mmioWrite(h, @p_buffer1^, samples * 4); // four bytes per sample
        Result := samples; // return number created/written
      end;
    slow, programmed, manual, no_sweep:
      begin
        // compute number of chunks in the sweep, ensure it's at least two
        // aim for about four different frequencies per second
        chunks := slow_sweep_chunks;
        if chunks < 2 then
          chunks := 2;
        // one sample occupies 2 bytes, 2 channels occupy 4 bytes, determine
        // number of samples in one chunk multipled by 4 to get filled bytes
        buffer_fill := chunk_ms * sample_rate div 1000; // samples per chunk
        buffer_fill := 4 * buffer_fill; // bytes per buffer
        f_ratio := exp(ln(f_max / f_min) / (chunks - 1)); // per step up
        f_inv_ratio := 1.0 / f_ratio; // and down
        f_step := (f_max + 0.01 - f_min) / (chunks - 1);
        fl := f_min;
        fr := fl;
        if speed = manual then
        begin
          tkbLeftFrequency.OnChange(Self); // tell trackbars that
          tkbRightFrequency.OnChange(Self); // the freqs have changed
        end;
        // build up list of chunk freqs - will use buffers_written as index
        if (speed = slow) or (speed = programmed) then
        begin
          // get frequency list memory, is freed either here or during
          // processing the mm_wom_close message
          GetMem(chunk_freq, slow_sweep_chunks * SizeOf(extended));
          f := f_min;
          chunk_freq^[0] := f; // define sweep base frequency
          for chunk := 1 to slow_sweep_chunks - 1 do
          begin
            if log_lin = linear then
              f := f + f_step
            else
              f := f * f_ratio;
            chunk_freq^[chunk] := f; // define next sweep frequency
          end;
          fl := chunk_freq[0]; // current f is now base frequency
          fr := fl; // and on the right channel as well
          if (h <> 0) then // emulate the sweep
          begin
            Screen.Cursor := crHourGlass;
            for chunk := 0 to slow_sweep_chunks - 1 do
            begin
              fl := chunk_freq^[chunk];
              fr := fl; // make the right channel the same frequency
              fill_buffer_with_sinewave(left_sine_table, p_buffer1, fl, left_angle, 0, buffer_fill div 4);
              // left channel samples
              fill_buffer_with_sinewave(right_sine_table, p_buffer1, fr, right_angle, 0, buffer_fill div 4);
              // right channel samples
              mmioWrite(h, @p_buffer1^, buffer_fill); // write the buffer
            end;
            Screen.Cursor := crDefault;
            FreeMem(chunk_freq);
            chunk_freq := nil;
          end;
        end;
        current_octave := get_octave(fl); // note the starting octave
        next_octave := current_octave;
        p_wave_hdr1^.dwBufferLength := buffer_fill; // actual buffer sizes
        p_wave_hdr2^.dwBufferLength := buffer_fill;
      end;
  end;
end;

procedure TfToneGenerator.mm_wom_Open(var Msg: TMessage);
// This code handles the WaveOutOpen message by writing two buffers of data
// to the wave device.  Plus other miscellaneous housekeeping.
var
  samples: integer; // max valid sample in the buffer
begin
  btnStart.Caption := '&STOP'; // first, tell the user how to stop the sound!

  // build sine-wave tables if required
  if not left_sine_table_valid then
    build_left_sine_table;
  if not right_sine_table_valid then
    build_right_sine_table;

  // populate the first wave header
  with p_wave_hdr1^ do
  begin
    // lpData := pChar(p_buffer1); // pointer to the data ;  Jim James
    lpData := pAnsiChar(p_buffer1); // pointer to the data
    dwBufferLength := 0; // fill in size later
    dwBytesRecorded := 0;
    dwUser := 0;
    dwFlags := 0;
    dwLoops := 1; // just a single loop
    lpNext := nil;
    reserved := 0;
  end;

  // populate the second wave header
  p_wave_hdr2^ := p_wave_hdr1^; // copy most of the data
  // p_wave_hdr2^.lpData := pChar(p_buffer2); // except the buffer address!   Jim James
  p_wave_hdr2^.lpData := pAnsiChar(p_buffer2); // except the buffer address!
  // fill in a single buffer that is repeated, fast sweep or white/pink noise
  // for a slow or single sweep, this sets up the frequencies
  samples := fill_buffer(0);

  case speed of
    fast_smooth, fast_stepped, white, pink:
      begin
        with p_wave_hdr1^ do
        begin
          dwBufferLength := 4 * samples; // convert samples to bytes
          dwFlags := whdr_BeginLoop or whdr_EndLoop; // repeating buffer
          // dwLoops := -1;                              // a fair number of loops
          dwLoops := $FFFFFFFF;
        end;
        // prepare both headers but only write the first (infinite loops)
        waveOutPrepareHeader(hWave_out, p_wave_hdr1, SizeOf(TWaveHdr));
        // mm_wom_close will unprepare both headers, so prepare this one anyhow
        waveOutPrepareHeader(hWave_out, p_wave_hdr2, SizeOf(TWaveHdr));
        waveOutWrite(hWave_out, p_wave_hdr1, SizeOf(TWaveHdr));
      end;
    slow, programmed, manual, no_sweep:
      begin
        buffers_played := 0;
        buffers_written := 0;
        all_written := False;
        // now write the first two buffers into the wave output
        // this will result in two mm_wom_done messages
        waveOutPrepareHeader(hWave_out, p_wave_hdr1, SizeOf(TWaveHdr));
        write_next_buffer(p_wave_hdr1);
        waveOutPrepareHeader(hWave_out, p_wave_hdr2, SizeOf(TWaveHdr));
        write_next_buffer(p_wave_hdr2);
      end;
  end;
  // LED1.StyleOnColor := clLime;
end;

procedure TfToneGenerator.write_next_buffer(header: PWaveHdr);
begin
  if shutoff then
    exit;
  if all_written then
    exit;
  with header^ do
  begin
    // check to see if a marker is required for the next buffer write
    if (speed = slow) and (do_markers) and (current_octave <> next_octave) then
    // marker required - fill buffer with silence for both channels
    begin
      FillChar(lpData^, dwBufferLength, 0);
      current_octave := next_octave; // update where we are
      lblLastMarker.Caption := 'Last at:' + #13 + Format('%.0f Hz', [fl]);
    end
    else // not required - fill buffer with sinewave data for both channels
    begin
      fill_buffer_with_sinewave(left_sine_table, PBuffer(lpData), fl, left_angle, 0, dwBufferLength div 4);
      // left channel samples
      fill_buffer_with_sinewave(right_sine_table, PBuffer(lpData), fr, right_angle, 0, dwBufferLength div 4);
      // right channel samples
    end;
    dwUser := round(fl); // note the frequency as an integer in the user field
  end;
  last_f := fl;

  // Write the buffer as soon as possible, will result in a mm_wom_done message
  waveOutWrite(hWave_out, header, SizeOf(TWaveHdr));
  Inc(buffers_written); // bump the number of buffers written

  // change the frequency as required
  case speed of
    no_sweep:
      ; // no frequency change
    manual:
      begin // manual frequency change
        case direction of
          up:
            begin
              if log_lin = linear then
                fl := fl + f_step
              else
                fl := fl * f_ratio;
              fr := fl;
              // check to see if we've reached the maximum frequency
              if fl >= f_max then
                direction := down;
            end;
          down:
            begin
              if log_lin = linear then
                fl := fl - f_step
              else
                fl := fl * f_inv_ratio;
              fr := fl;
              // check to see if we've reached the maximum frequency
              if fl <= f_min then
                direction := up;
            end;
        else
          // do nothing in the "holding frequency" case
        end;
        direction := holding;
      end;
  else
    begin // normal frequency sweep
      all_written := buffers_written >= slow_sweep_chunks;
      if not all_written then
      begin
        fl := chunk_freq^[buffers_written];
        fr := fl; // and make the right channel the same frequency
        next_octave := get_octave(fl);
      end;
    end;
  end;
end;

procedure TfToneGenerator.mm_wom_Done(var Msg: TMessage);
// handle the wave out done message by writing the next buffer, if required
var
  free_header: PWaveHdr;
begin
  case speed of
    fast_smooth, fast_stepped, white, pink:
      ; // nothing to do
    slow, programmed, manual, no_sweep:
      begin
        // note the fact that another buffer has been completed
        Inc(buffers_played);
        // point to wave header just completed, i.e. the next free buffer
        free_header := PWaveHdr(Msg.lParam);
        if not shutoff then
        begin
          if buffers_played >= buffers_written then
          begin
            // everything written has been played
            shutoff := True;
            sweep_running := False;
            closing := False; // say we're not closing just yet
          end
          else
          begin
            // make a note of the last frequency for the user
            lblFnow.Caption := Format('%.0f Hz', [last_f]);
            // and write the next buffer, re-using the one just played
            write_next_buffer(free_header);
          end
        end;
      end;
  end;
  if shutoff then
  begin
    waveOutReset(hWave_out);
    waveOutClose(hWave_out);
  end;
end;

procedure TfToneGenerator.mm_wom_Close(var Msg: TMessage);
// handle the wave out close message, release the wave headers
begin
  waveOutUnprepareHeader(hWave_out, p_wave_hdr1, SizeOf(TWaveHdr));
  waveOutUnprepareHeader(hWave_out, p_wave_hdr2, SizeOf(TWaveHdr));
  p_wave_hdr1 := PWaveHdr(GlobalLock(hWave_hdr1));
  if p_wave_hdr1 = nil then
    ShowMessage('Failed to re-lock buffer p_wave_hdr1!');
  p_wave_hdr2 := PWaveHdr(GlobalLock(hWave_hdr2));
  if p_wave_hdr2 = nil then
    ShowMessage('Failed to re-lock buffer p_wave_hdr2!');
  if chunk_freq <> nil then
    FreeMem(chunk_freq);
  lblFnow.Visible := False;
  btnStart.Caption := '&Start';
  grpChannels.Enabled := True; // restore the output channels options group
  grpOctaveMarkers.Enabled := True;
  gbFrequencyRange.Enabled := True;
  grpSweepMode.Enabled := True;
  grpSweepSpeed.Enabled := True;
  chkOctaveMarker.Enabled := lblLastMarker.Enabled;
  edtF1.Enabled := True;
  edtF2.Enabled := True;
  // LED1.StyleOnColor := clGreen;
  tkbLeftLevel.Enabled := True;
  tkbRightLevel.Enabled := True;
  lblLeftLevel.Enabled := True;
  lblRightLevel.Enabled := True;
  chkLeft.Enabled := True;
  chkRight.Enabled := True;
  hWave_out := 0;
  closed := True;
  if closing then
    Close;
end;

function TfToneGenerator.get_octave(f: extended): integer;
// This function is designed to find out which in octave a
// given frequency lies.  On a Pentium 100 it takes about 2us
const
  log2 = 0.301029995664; // use this for octave markers
  half_log2 = 0.150514997832; // and this for half-octave markers
begin
  Result := Trunc(Log10(f) / half_log2);
end;

procedure TfToneGenerator.build_sine_table(magnitude: extended; table: PSineTable);
var
  i: integer;
  quarter_table: integer;
  half_table: integer;
  x: integer;
begin { tkbRightLevel and tbkLeftLever max were 26... }
  // Assume 16-bit audio goes from -32767..32767, avoids clipping.
  // There are only 2^15 samples here, this simplfies the subsequent angle
  // calculation but might restrict the dynamic range produced with noise
  // sidebands.  However, in the quality of equipment likely to be
  // encountered this won't matter.  You've got the source code, so
  // you can alter this if you like.
  half_table := sine_table_samples div 2;
  quarter_table := half_table div 2;
  table^[0] := 0;
  x := round(magnitude * 32767.0);
  table^[quarter_table] := x;
  table^[half_table] := 0;
  table^[half_table + quarter_table] := -x;
  for i := 1 to quarter_table - 1 do
  begin
    x := round(magnitude * (32767.0 * sin(2.0 * i * Pi / sine_table_samples)));
    table^[i] := x;
    table^[half_table - i] := x;
    table^[half_table + i] := -x;
    table^[sine_table_samples - i] := -x;
  end;
end;

procedure TfToneGenerator.build_left_sine_table;
begin
  if left_sine_table_valid then
    exit; // nothing to do

  build_sine_table(left_amplitude, left_sine_table);
  present_left_amplitude := left_amplitude;
  left_sine_table_valid := True;
end;

procedure TfToneGenerator.build_right_sine_table;
begin
  if right_sine_table_valid then
    exit; // nothing to do

  // invert the sinewave by negating the amplitude
  if out_level = phase_reverse then
    build_sine_table(-right_amplitude, right_sine_table)
  else
    build_sine_table(right_amplitude, right_sine_table);
  present_right_amplitude := right_amplitude;
  right_sine_table_valid := True;
end;

procedure TfToneGenerator.fill_buffer_with_sinewave(sine_table: PSineTable; bfr: PBuffer; f: extended;
  var angle: integer; index, samples: integer);
// Fills a section of 2-channel buffer with sinewave.  The angle parameter is
// updated so that phase continuity is maintained between calls to this routine
// If the right-hand sine table is given as the parameter, the buffer is
// written with a one sample offset, i.e. the right channel
const
  fract_bits = 15;
var
  sample: integer; // looping over the required samples
  d_angle: integer; // 32-bit number, with 15 fractional bits, i.e. 17.15
  max_angle: integer; // maximum number of samples in the sine table
  w: audio_sample; // one single sample
begin
  // Compute the angular step per sample corresponding to the desired frequency
  d_angle := round((sine_table_samples shl fract_bits) * f / sample_rate);

  // This is the maximum number of samples in the sine table
  max_angle := (sine_table_samples shl fract_bits) - 1;

  // point index to right-hand sample if required
  if sine_table = right_sine_table then
    Inc(index);
  for sample := 0 to samples - 1 do
  begin
    w := sine_table^[angle shr fract_bits]; // get current sine value
    bfr^[index] := w; // store it in the caller's buffer
    Inc(index, 2); // point past next Left or Right
    Inc(angle, d_angle); // bump the angle
    angle := angle and max_angle; // wrap to 360 degrees
  end;
end;

function TfToneGenerator.fill_single_sweep_bfr(bfr: PBuffer; num_freqs: integer): integer;
// This procedure fills a single buffer with a frequency sweep.
// To allow for oscilloscope retrace and retrigger time, the buffer
// is prefixed with about 25% duration of silence.
// Both log and linear sweeps can be provided
// Returns the number of samples in the buffer
var
  sample, chunk_samples, retrace_steps: integer;
  i, n_freq: integer;
  l_angle, r_angle: integer;
begin
  // for linear sweep, compute the frequency step
  f_step := (f_max + 0.01 - f_min) / (num_freqs - 1);

  // for log sweep, compute the frequency ratio per step
  f_ratio := exp(ln(f_max / f_min) / (num_freqs - 1));

  retrace_steps := num_freqs div 3; // allow about 25% retrace time
  chunk_samples := buffer_bytes div (2 * (num_freqs + retrace_steps));
  sample := 0;
  l_angle := 0; // save angle to keep phase continuous
  r_angle := 0; // save angle to keep phase continuous
  fl := f_min;
  fr := f_min;

  // for all buffer chunks, including silence
  for n_freq := 1 to retrace_steps + num_freqs do
  begin
    if n_freq <= retrace_steps then
      for i := 0 to chunk_samples - 1 do // over the entire chunk
      begin
        bfr^[sample] := 0; // insert silence - left sample
        Inc(sample); // point to right sample
        bfr^[sample] := 0; // insert silence - right sample
        Inc(sample); // point to next left sample
      end
    else
    begin
      // stuff sinewave into this chunk
      fill_buffer_with_sinewave(left_sine_table, bfr, fl, l_angle, sample, chunk_samples);
      fill_buffer_with_sinewave(right_sine_table, bfr, fr, r_angle, sample, chunk_samples);
      Inc(sample, 2 * chunk_samples);
      // compute next frequency according to the sweep mode
      if log_lin = linear then
        fl := fl + f_step
      else
        fl := fl * f_ratio;
      fr := fl;
    end;
  end;

  Result := sample div 2;
end;

function TfToneGenerator.fill_white_noise_bfr(bfr: PBuffer): integer;
// This procedure fills a single buffer with white noise
// Returns the number of audio samples in the buffer
var
  sample: integer;
  sample_pos: integer;
  samples: integer;
  l_value: integer;
  r_value: integer;
  l_magnitude: extended;
  r_magnitude: extended;
  value: extended;
begin
  // note the amplitude required and record that this has been set
  l_magnitude := left_amplitude;
  present_left_amplitude := l_magnitude;
  r_magnitude := right_amplitude;
  present_right_amplitude := r_magnitude;

  // for out-of-phase, invert the right channel
  if out_level = phase_reverse then
    r_magnitude := -r_magnitude;

  samples := buffer_bytes div 2;
  sample_pos := 0;
  for sample := 0 to samples - 1 do
  begin
    value := Random * 65536.0 - 32768.0;
    l_value := round(l_magnitude * value);
    r_value := round(r_magnitude * value);
    bfr^[sample_pos] := l_value; // set left sample
    Inc(sample_pos); // point to right sample
    bfr^[sample_pos] := r_value; // set right sample
    Inc(sample_pos); // point to next left sample
  end;
  Result := samples;
end;

function TfToneGenerator.fill_pink_noise_bfr(bfr: PBuffer): integer;
// This procedure fills a single buffer with white noise
// Returns the number of audio samples in the buffer
var
  sample: integer;
  sample_pos: integer;
  samples: integer;
  l_value: integer;
  r_value: integer;
  l_magnitude: extended;
  r_magnitude: extended;
  value: extended;
begin
  exit; // no pink
  Result := 0;
  if pink_noise_buffer = nil then
    read_pink_noise_file(ExtractFilePath(Application.ExeName) + pink_noise_filename);

  if pink_noise_buffer = nil then
    exit;

  // note the amplitude required and record that this has been set
  l_magnitude := left_amplitude;
  present_left_amplitude := l_magnitude;
  r_magnitude := right_amplitude;
  present_right_amplitude := r_magnitude;

  // for out-of-phase, invert the right channel
  if out_level = phase_reverse then
    r_magnitude := -r_magnitude;

  samples := buffer_bytes div 2;
  sample_pos := 0;
  for sample := 0 to samples - 1 do
  begin
    value := pink_noise_buffer^[sample];
    l_value := round(l_magnitude * value);
    r_value := round(r_magnitude * value);
    bfr^[sample_pos] := l_value; // set left sample
    Inc(sample_pos); // point to right sample
    bfr^[sample_pos] := r_value; // set right sample
    Inc(sample_pos); // point to next left sample
  end;
  Result := samples;
end;

procedure TfToneGenerator.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  stop_sweep;
  shutoff := True;
end;

procedure TfToneGenerator.btnStartKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_PRIOR:
      direction := up; // Page Up key
    VK_NEXT:
      direction := down; // Page Down key
  end;
end;

procedure TfToneGenerator.tkbLeftFrequencyChange(Sender: TObject);
begin
  // Compute the frequency corresponding to the trackbar setting.
  // Note that trackbar is treated in a log or linear basis
  // according to the current mode.
  with tkbLeftFrequency do
  begin
    // get the left channel frequency
    if log_lin = linear then
    begin
      fl := f_min + (f_max - f_min) * (Max - Position) / (Max - Min);
      if cbChirp.Checked then
        fl := fl + FChirpCum;
    end
    else
    begin
      fl := f_min * exp(ln(f_max / f_min) * (Max - Position) / (Max - Min));
      if cbChirp.Checked then
        fl := fl + FChirpCum;
    end;

    lblFLeft.Caption := Format('%.0f Hz', [fl]); // display the freq
    if locked_frequencies then // make right the same
      if Position <> tkbRightFrequency.Position then // is it different?
      begin
        tkbRightFrequency.Position := Position; // no - update position
        tkbRightFrequency.OnChange(Self); // and tell the control
        fr := fl; // record the right freq
      end;
  end;
end;

procedure TfToneGenerator.tkbRightFrequencyChange(Sender: TObject);
begin
  with tkbRightFrequency do
  begin
    if log_lin = linear then
      fr := f_min + (f_max - f_min) * (Max - Position) / (Max - Min)
    else
      fr := f_min * exp(ln(f_max / f_min) * (Max - Position) / (Max - Min));
    lblFRight.Caption := Format('%.0f Hz', [fr]);
    if locked_frequencies then
      if Position <> tkbLeftFrequency.Position then
      begin
        tkbLeftFrequency.Position := Position;
        tkbLeftFrequency.OnChange(Self);
        fl := fr;
      end;
  end;
end;

procedure TfToneGenerator.tkbLeftLevelChange(Sender: TObject);
begin
  with tkbLeftLevel do
  begin
    if out_level <> independent then // we should make Left = Right
    begin
      if Position <> tkbRightLevel.Position then // is it different?
      begin
        tkbRightLevel.Position := Position; // yes - update the position
        tkbRightLevelChange(Self); // wake up the control
      end;
    end;
  end;
  level_changed; // update as required
end;

procedure TfToneGenerator.tkbRightLevelChange(Sender: TObject);
begin
  with tkbRightLevel do
  begin
    if out_level <> independent then
    begin
      if Position <> tkbLeftLevel.Position then
      begin
        tkbLeftLevel.Position := Position;
        tkbLeftLevelChange(Self);
      end;
    end;
  end;
  level_changed;
end;

procedure TfToneGenerator.grpChannelsClick(Sender: TObject);
begin
  out_level := out_levels(grpChannels.ItemIndex);
  left_sine_table_valid := False; // force a recalculation
  right_sine_table_valid := False; // on both channels
end;

procedure TfToneGenerator.chkLeftClick(Sender: TObject);
// handle a click on either output enable check boxes
begin
  level_changed;
end;

procedure TfToneGenerator.cbLockFreqClick(Sender: TObject);
begin
  locked_frequencies := cbLockFreq.Checked;
end;

procedure TfToneGenerator.edtF1Change(Sender: TObject);
begin
  lblFMinR.Caption := edtF1.Text;
  lblFMinL.Caption := edtF1.Text;
end;

procedure TfToneGenerator.edtF2Change(Sender: TObject);
begin
  lblFMaxR.Caption := edtF2.Text;
  lblFMaxL.Caption := edtF2.Text;
end;

procedure TfToneGenerator.Exit1Click(Sender: TObject);
begin
  Close;
end;

function TfToneGenerator.read_pink_noise_file(const filename: string): Boolean;
var
  h: HMMIO;
  wave_chunk: TMMCKINFO;
  subchunk: TMMCKINFO;
  Format: PWaveFormat;
begin
  exit; // Debug exit
  Result := False;
  pink_noise_buffer := nil;

  h := mmioOpen(pChar(filename), nil, MMIO_READ);
  if h = 0 then
    ShowMessage('Error opening pink noise wave file (' + filename + ')')
  else
  begin
    wave_chunk.fccType := mmioStringToFOURCC('WAVE', 0);
    if mmioDescend(h, @wave_chunk, nil, MMIO_FINDRIFF) <> 0 then
      ShowMessage('File: ' + filename + ' is not a valid WAVE file')
    else
    begin
      subchunk.ckid := mmioStringToFOURCC('fmt ', 0);
      if mmioDescend(h, @subchunk, @wave_chunk, MMIO_FINDCHUNK) <> 0 then
        ShowMessage('WAVE file: ' + filename + ' has no fmt chunk')
      else
      begin
        GetMem(Format, subchunk.cksize);
        // mmioRead(h, PChar(format), subchunk.cksize);  Jim James
        mmioRead(h, pAnsiChar(Format), subchunk.cksize);
        mmioAscend(h, @subchunk, 0);
        subchunk.ckid := mmioStringToFOURCC('data', 0);
        if mmioDescend(h, @subchunk, @wave_chunk, MMIO_FINDCHUNK) <> 0 then
          ShowMessage('WAVE file: ' + filename + ' has no data chunk')
        else
        begin
          // check it's 16-bit, mono, at 44.1KHz
          with Format^ do
            if (wFormatTag <> wave_Format_PCM) or (nChannels <> 1) or (nSamplesPerSec <> sample_rate) or
              (nAvgBytesPerSec <> sample_rate * 2) or (nBlockAlign <> 2) then
              ShowMessage('WAVE file: ' + filename + ' is not 44.1KHz mono')
            else
              if subchunk.cksize < SizeOf(TMonoBuffer) then
                ShowMessage('WAVE file: ' + filename + ' is too short')
              else
              begin
                GetMem(pink_noise_buffer, SizeOf(TMonoBuffer));
                if pink_noise_buffer = nil then
                  ShowMessage('Failed to get memory for pink noise buffer')
                else
                  // mmioRead(h, PChar(pink_noise_buffer), SizeOf(TMonoBuffer)); Jim James
                  mmioRead(h, pAnsiChar(pink_noise_buffer), SizeOf(TMonoBuffer));
              end;
        end;
        FreeMem(Format);
      end;
    end;
    // finished reading the MMIO wave file
    mmioClose(h, 0);
  end;
end;

procedure TfToneGenerator.cbChirpClick(Sender: TObject);
begin

  timerChirp.Enabled := cbChirp.Checked;
  if not cbChirp.Checked then
    FChirpCum := 0;
end;

procedure TfToneGenerator.timerChirpTimer(Sender: TObject);
begin
  FChirpCum := FChirpCum + nsChirp.value;
  lblChirpCum.Caption := 'Cum:' + FloatToStrF(FChirpCum, ffGeneral, 4, 5);
  tkbLeftFrequencyChange(Self);
end;

end.
